home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d27
/
backup.arc
/
BKP100.RPG
< prev
next >
Wrap
Text File
|
1991-12-04
|
37KB
|
457 lines
~ H* * CRTRPGPGM PGM(BKP100.YOURLIB) SRCFILE(YOUSRC.YOURLIB) +
~ H* USRPRF(*USER) PUBAUT(*NORMAL) *
~ H*
~ H* ***********************************************************
~ H* * PROGRAM: BKP100.YOURLIB *
~ H* * DISCRIPTION: BACKUP FILE MAINTENANCE *
~ H* * *
~ H* * *
~ H* * COMPILATION OPTIONS: CREATE DSPOBJD OUTFILE FIRST. *
~ H* * SWITCHES: NONE *
~ H* * *
~ H* * WRITEN BY BRIAN GREWAL. *
~ H* * *
~ H* * DITO DITTO DITTTO *
~ H* * *
~ H* * *
~ H* * *
~ H* * *
~ H* ***********************************************************
~ H*
FBACKUPF UF E K DISK A
FDSPOBJD IF E DISK UC
FBKP100FMCF E WORKSTN
F LRRN KSFILE LIBSFL
F ORRN KSFILE OBJSFL
E OPT 6 1 OPTION FOR LIBS
E OOPT 6 1 OPTION FOR OBJS
E LIB 6 10 LIBRARY NAMES
E OBJ 6 10 OBJECT NAMES
E CMD 80 80 1 DSPOBJD COMMAND
E OVR 50 50 1 OVRDBF COMMAND
ILIBSFL
I OPT1 OPT,1
I OPT2 OPT,2
I OPT3 OPT,3
I OPT4 OPT,4
I OPT5 OPT,5
I OPT6 OPT,6
I LIB1 LIB,1
I LIB2 LIB,2
I LIB3 LIB,3
I LIB4 LIB,4
I LIB5 LIB,5
I LIB6 LIB,6
IOBJSFL
I OOPT1 OOPT,1
I OOPT2 OOPT,2
I OOPT3 OOPT,3
I OOPT4 OOPT,4
I OOPT5 OOPT,5
I OOPT6 OOPT,6
I OBJ1 OBJ,1
I OBJ2 OBJ,2
I OBJ3 OBJ,3
I OBJ4 OBJ,4
I OBJ5 OBJ,5
I OBJ6 OBJ,6
~ C* DEFINE KEY
~ C*
C KEY KLIST ~
C KFLD WBKPTP ~
C KFLD SAVCOD ~
C KFLD LIBNAM ~
C KFLD OBJNAM ~
~ C**
~ C* SET ON/OFF SWITCHES FOR INDICATORS
C MOVE '1' ON 1 ~
C MOVE '0' OFF 1 ~
C *IN99 DOWEQOFF ~
C FMENU TAG ~
C EXFMTMENU ~
C *IN99 CABEQON EXIT ~CMD 1 PRESSED
C OPTION CABEQ0 FMENU 90~INVALID OPTION
~ C* RESET INDICATORS
C SETOF 717273~
C SETOF 7490 ~
~ C* INITIALIZE FIELDS
C MOVE *BLANKS LIBNAM ~
C MOVE *BLANKS OBJNAM ~
C MOVE ' ' SAVCOD ~
~ C* DAILY BACKUP
C OPTION IFEQ 1 ~
C MOVE 'D' WBKPTP 1 ~
C SETON 71 ~
C ELSE ~
~ C* WEEKLY BACKUP
C OPTION IFEQ 2 ~
C MOVE 'W' WBKPTP ~
C SETON 72 ~
~ C* MONTHLY BACKUP
C ELSE ~
C OPTION IFEQ 3 ~
C MOVE 'M' WBKPTP ~
C SETON 73 ~
~ C* SPECIAL BACKUP
C ELSE ~
C MOVE 'S' WBKPTP ~
C SETON 74 ~
C END ~OPTION EQ 3
C END ~OPTION EQ 2
C END ~OPTION EQ '1'
C KEY SETLLBACKUPF ~
C FINPUT TAG ~
C WRITEINPCMD ~
C EXFMTINPUT ~
C *IN99 CABEQON FMENU ~
C SETOF 8081 ~
~ C* SEARCH REQUESTED
C SEARCH IFNE *BLANK ~
C EXSR SRHSR ~
C GOTO FINPUT ~
C END ~SEARCH NE *BLA
~ C* DELETE REQUESTED
C *IN98 IFEQ ON ~DELETE RECORD
C KEY CHAINBACKUPF 55 ~
C N55 DELETRBACKUPF ~
C MOVE *BLANKS LIBNAM ~
C MOVE *BLANKS OBJNAM ~
C MOVE *BLANKS SAVCOD ~
C GOTO FINPUT ~
C END ~*IN98 EQ ON
~ C* ROLL UP REQUESTED
C *IN97 IFEQ ON ~ROLL UP
C EXSR ROLLUP ~
C GOTO FINPUT ~
C END ~*IN97 EQ ON
~ C* ROLL DOWN REQUESTED
C *IN96 IFEQ ON ~ROLL DOWN
C EXSR ROLLDN ~
C GOTO FINPUT ~
C END ~*IN96 EQ ON
C MOVELLIBNAM LIBCHK 1 ~
C MOVELOBJNAM OBJCHK 1 ~
~ C* LIBRARY SEARCH REQUESTED
C LIBCHK IFEQ '*' ~
C SETON 40 ~
C EXSR BLDPF ~
C EXSR SUBFIL ~
C SETOF 9979 ~
C GOTO FINPUT ~
C END ~LIBCHK EQ '*'
~ C* SAVE CODE CHECK
~ C* SKIP SAVE CODE EDIT IF IT IS MONTHLY BACKUP *IN 73
C *IN73 IFEQ OFF ~
C SAVCOD IFNE 'A' ~
C SAVCOD ANDNE'S' ~
C SETON 80 ~
C GOTO FINPUT ~
C END ~SAVCOD NE 'S'
C SAVCOD IFEQ 'A' ~
C OBJNAM ANDNE*BLANK ~
C SETON 83 ~
C GOTO FINPUT ~
C END ~SAVCOD NE 'S'
C SAVCOD IFEQ 'S' ~
C OBJNAM ANDEQ*BLANK ~
C SETON 81 ~
C GOTO FINPUT ~
C END ~SAVCOD NE 'S'
C END ~*IN73 IFEQ OFF
~ C* OBJECT SEARCH REQUESTED
C OBJCHK IFEQ '*' ~
C SETOF 40 ~
C LIBNAM IFEQ *BLANKS ~
C SETON 82 ~
C GOTO FINPUT ~
C END ~SAVCOD NE A S
C EXSR BLDPF ~
C EXSR OBJSRH ~
C SETOF 99 ~
C GOTO FINPUT ~
C END ~OBJCHK EQ '*'
C EXSR UPDADD ~
C GOTO FINPUT ~
C END ~*IN99 DOWEQ OF
C EXIT TAG ~
C SETON LR ~
~ C****************************************************
CSR UPDADD BEGSR ~
~ C****************************************************
~ C** DEFAULT MONTHLY SAVCODE WITH "A"
CSR 73 MOVE 'A' SAVCOD ~
CSR MOVE LIBNAM WLIB 10 ~
CSR MOVE OBJNAM WOBJ 10 ~
CSR MOVE SAVCOD WSAV 1 ~
CSR KEY CHAINBACKUPF 46 ~
CSR MOVE WLIB LIBNAM ~
CSR MOVE WOBJ OBJNAM ~
CSR MOVE WBKPTP BKPTYP ~
CSR MOVE WSAV SAVCOD ~
~ C**
CSR 46 WRITERBACKUPF ~
CSRN46 UPDATRBACKUPF ~
~ C****************************************************
CSR ENDSR ~
~ C****************************************************
~ C****************************************************
CSR SRHSR BEGSR ~
~ C****************************************************
CSR MOVE SEARCH LIBNAM ~
CSR KEY SETLLBACKUPF ~
CSR READ BACKUPF 20~20 = EOF
CSR *IN20 IFEQ ON ~
CSR BKPTYP ORNE WBKPTP ~
CSR MOVE *BLANKS LIBNAM ~
CSR MOVE *BLANKS OBJNAM ~
CSR MOVE *BLANKS SAVCOD ~
CSR END ~SEARCH EQ *BLA
~ C****************************************************
CSR ENDSR ~
~ C****************************************************
~ C****************************************************
CSR ROLLUP BEGSR ~
~ C****************************************************
CSR READ BACKUPF 20~20 = EOF
CSR *IN20 IFEQ ON ~
CSR BKPTYP ORNE WBKPTP ~
CSR MOVE *BLANKS LIBNAM ~
CSR MOVE *BLANKS OBJNAM ~
CSR MOVE *BLANKS SAVCOD ~
CSR END ~*IN20 EQ ONF
CSR 20 WBKPTP SETLLBACKUPF ~
~ C****************************************************
CSR ENDSR ~
~ C****************************************************
~ C****************************************************
CSR ROLLDN BEGSR ~
~ C****************************************************
CSR READPBACKUPF 20~20 = EOF
CSR *IN20 IFEQ ON ~
CSR BKPTYP ORNE WBKPTP ~
CSR MOVE *BLANKS OBJNAM ~
CSR MOVE *BLANKS SAVCOD ~
CSR END ~*IN20 EQ ONF
CSR 20 WBKPTP SETGTBACKUPF ~
~ C****************************************************
CSR ENDSR ~
~ C****************************************************
~ C****************************************************
CSR BLDPF BEGSR ~
~ C****************************************************
CSR MOVE *BLANKS OBJECT 10 ~
CSR MOVE *BLANKS LIBRAR 10 ~
CSR MOVE *BLANKS TYPE 10 ~
CSR *IN40 IFEQ ON ~
CSR MOVEL'*ALL' OBJECT ~
CSR MOVEL'QSYS' LIBRAR ~
CSR MOVEL'*LIB' TYPE ~
CSR ELSE ~
CSR MOVEL'*ALL' OBJECT ~
CSR MOVELLIBNAM LIBRAR ~
CSR MOVEL'*ALL' TYPE ~
CSR END ~*IN40 EQ ON
CSR CALL 'BLDQLFC' ~
CSR PARM OBJECT ~
CSR PARM LIBRAR ~
CSR PARM QLFNAM 21 ~
CSR MOVEAQLFNAM CMD,9 ~
CSR MOVEATYPE CMD,31 ~
CSR Z-ADD80 LENGTH 155 ~
CSR CALL 'QCAEXEC' ~
CSR PARM CMD ~
CSR PARM LENGTH ~
CSR Z-ADD50 LENGTH 155 ~
CSR CALL 'QCAEXEC' ~
CSR PARM OVR ~
CSR PARM LENGTH ~
~ C****************************************************
CSR ENDSR ~
~ C****************************************************
~ C****************************************************
CSR SUBFIL BEGSR ~
~ C****************************************************
CSR SETOF 51 ~
CSR Z-ADD0 LRRN 50 ~
CSR WRITELIBCTL ~
CSR SETON 51 ~
CSR OPEN DSPOBJD ~
CSR SETOF 4245 ~
CSR *IN42 DOWEQOFF ~
CSR Z-ADD0 S 10 ~
CSR MOVE *BLANKS LIB ~
CSR MOVE *BLANKS OPT ~
CSR S DOWLE5 ~
CSR READ DSPOBJD 42~
~ C** SKIP ALL LIBRARIES START WITH Q
CSR 40N42 MOVELODOBNM SYSLIB 1 ~
CSR *IN42 IFEQ OFF ~
CSR SYSLIB ANDNE'Q' ~
CSR ADD 1 S ~
CSR MOVELODOBNM LIB,S ~
CSR MOVELODOBNM LIBNAM ~
~ C** DOES LIBRARY ALREADY EXIST
CSR KEY SETLLBACKUPF ~
CSR READ BACKUPF 46~
CSR BKPTYP IFEQ WBKPTP ~
CSR LIBNAM ANDEQODOBNM ~
CSR *IN46 ANDEQOFF ~
CSR MOVE 'X' OPT,S ~
CSR ELSE ~
CSR MOVE ' ' OPT,S ~
CSR END ~BKPTYP IFEQ WB
~ C**
CSR END ~*IN42 IFEQ OFF
CSRN42 END ~S DOWLE 5
CSR S IFGT 0 ~
CSR ADD 1 LRRN ~
CSR WRITELIBSFL ~
CSR END ~S IFGT 0
CSRN42 END ~*IN42 DOWEQ OF
CSR MOVE *BLANKS LIBNAM ~
CSR MOVE *BLANKS OBJNAM ~
CSR MOVE *BLANKS SAVCOD ~
CSR CLOSEDSPOBJD ~
CSR WRITEINPUT ~
CSR WRITECMDKEY ~
CSR EXFMTLIBCTL ~
CSR *IN99 CABEQON ENDSFL ~
CSR MOVEA'000000' *IN,81 ~
CSR *IN45 DOWEQOFF ~
CSR READCLIBSFL 45~
CSR *IN45 IFEQ OFF ~
CSR Z-ADD0 S 10 ~
CSR S DOWLE5 ~
CSR ADD 1 S ~
CSR OPT,S IFEQ 'X' ~
CSR LRRN CHAINLIBSFL 81 ~
~ C** HIGHLIGHT AND REVERSE CURRENT LIBRARY NAME
CSR S COMP 1 81~
CSR S COMP 2 82~
CSR S COMP 3 83~
CSR S COMP 4 84~
CSR S COMP 5 85~
CSR S COMP 6 86~
CSR UPDATLIBSFL ~
~ C**
CSR MOVEA'000000' *IN,81 ~
CSR WRITECMDKEY ~
CSR WRITELIBCTL ~
~ C** EXECUTE FOLLOWING COMMANDS ONLY IF BACKUP TYPE NOT MONTHLY
CSR *IN73 IFEQ OFF ~
CSR SINPUT TAG ~
CSR SETON 79 ~
CSR MOVEALIB,S LIBNAM ~
CSR MOVE 'A' SAVCOD ~
CSR MOVE *BLANKS OBJNAM ~
~ C** RETRIVE PREVIOUS SAVE CODE
CSR KEY SETLLBACKUPF ~
CSR READ BACKUPF 46~
CSR BKPTYP IFNE WBKPTP ~
CSR LIBNAM ORNE LIB,S ~
CSR *IN46 OREQ ON ~
CSR MOVE ' ' SAVCOD ~
CSR MOVE *BLANKS OBJNAM ~
CSR MOVE *BLANKS LIBNAM ~
CSR END ~BKPTYP IFNE WB
~ C**
CSR MOVEALIB,S LIBNAM ~
CSR EXFMTINPUT ~
CSR MOVEA'0000' *IN,80 ~
CSR *IN99 CABEQON ENDSFL ~
CSR MOVELLIBNAM LIBCHK ~
CSR MOVELOBJNAM OBJCHK ~
CSR SAVCOD IFNE 'A' ~
CSR SAVCOD ANDNE'S' ~
CSR SETON 80 ~
CSR GOTO SINPUT ~
CSR END ~SAVCOD NE 'S'
CSR SAVCOD IFEQ 'A' ~
CSR OBJNAM ANDNE*BLANK ~
CSR SETON 83 ~
CSR GOTO SINPUT ~
CSR END ~SAVCOD NE 'S'
CSR SAVCOD IFEQ 'S' ~
CSR OBJNAM ANDEQ*BLANK ~
CSR SETON 81 ~
CSR GOTO SINPUT ~
CSR END ~SAVCOD NE 'S'
~ C* OBJECT SEARCH REQUESTED
CSR OBJCHK IFEQ '*' ~
CSR SETOF 40 ~
CSR Z-ADDS SAVES 10 ~
CSR EXSR BLDPF ~
CSR EXSR OBJSRH ~
CSR Z-ADDSAVES S ~
CSR 99 GOTO SINPUT ~
CSR ELSE ~
CSR MOVE WBKPTP BKPTYP ~
CSR EXSR UPDADD ~
CSR END ~OBJCHK EQ '*'
CSR ELSE ~
CSR MOVE LIB,S LIBNAM ~
CSR MOVE *BLANKS OBJNAM ~
CSR EXSR UPDADD ~
CSR END ~*IN73 IFEQ OFF
CSR END ~OPT,S IFEQ 'X'
CSR END ~S DOWLE 5
~ C** RESET DSPLAY ATTRIBUTES
CSR MOVEA'000000' *IN,81 ~
CSR LRRN CHAINLIBSFL 81 ~
CSR UPDATLIBSFL ~
CSR END ~*IN45 IFEQ OFF
CSRN45 END ~*IN45 DOWEQ OF
~ C****************************************************
CSR ENDSFL ENDSR ~
~ C****************************************************
~ C****************************************************
CSR OBJSRH BEGSR ~
~ C****************************************************
CSR SETOF 51 ~
CSR Z-ADD0 ORRN 50 ~
CSR WRITEOBJCTL ~
CSR SETON 5184 ~
CSR OPEN DSPOBJD ~
CSR SETOF 4245 ~
CSR *IN42 DOWEQOFF ~
CSR Z-ADD0 S 10 ~
CSR MOVE *BLANKS OBJ ~
CSR MOVE *BLANKS OOPT ~
CSR S DOWLE5 ~
CSR ADD 1 S ~
CSR READ DSPOBJD 42~
CSRN42 MOVELODOBNM OBJ,S ~
CSRN42 MOVELODOBNM OBJNAM ~
CSRN42 KEY CHAINBACKUPF 45 ~
CSRN42N45 MOVE 'X' OOPT,S ~
CSR END ~S DOWLE 5
CSR ADD 1 ORRN ~
CSR WRITEOBJSFL ~
CSRN42 END ~*IN42 DOWEQ OF
CSR CLOSEDSPOBJD ~
CSR SETOF 45 ~
CSR WRITECMDKEY ~
CSR EXFMTOBJCTL ~
CSR *IN99 CABEQON ENDOBJ ~
CSR *IN45 DOWEQOFF ~
CSR READCOBJSFL 45~
CSR *IN45 IFEQ OFF ~
CSR Z-ADD0 S 10 ~
CSR S DOWLE5 ~
CSR ADD 1 S ~
CSR OOPT,S IFEQ 'X' ~
CSR MOVEAOBJ,S OBJNAM ~
CSR MOVE WBKPTP BKPTYP ~
CSR EXSR UPDADD ~
CSR END ~OPT,S IFEQ 'X'
CSR END ~S DOWLE 5
CSR END ~*IN45 IFEQ OFF
CSR END ~*IN45 DOWEQ OF
~ C****************************************************
CSR ENDOBJ ENDSR ~
~ C****************************************************
** DISPLAY OBJECT DISCRIPTION TO FILE ****
DSPOBJD 9XXXXXXXXX.XXXXXXXXXX 31XXXXXXXX *FULL *NONE DSPOBJD.QTEMP
** OVRIDE DATA BASE FILE ****
OVRDBF DSPOBJD DSPOBJD.QTEMP SECURE(*YES)